﻿unit zglControls;

{$IFDEF FPC}
  {$MODE DELPHI}
{$ENDIF}

//Объекты для отображения ГУИ
//TODO: доработать TGuiListBox
//TODO: сделать TGuiEdit

interface

uses
  zglHeader, c_list;//, Controls;

const
  GUITYPE_BUTTON = 1;

type
  //Цвет, устанавливаемый для контролов
  TRGBColor = record
    case Cardinal of
      1: (B, G, R, A: Byte;);
      2: (argb: Cardinal;);
  end;

  PPadding = ^TPadding;
  TPadding = class
  private
    aTop:    Single;
    aBottom: Single;
    aLeft:   Single;
    aRight:  Single;
    procedure SetPadds(Val: Single);
  public
    constructor Create;
    property Top: Single read aTop write aTop;
    property Bottom: Single read aBottom write aBottom;
    property Left: Single read aLeft write aLeft;
    property Right: Single read aRight write aRight;
    property All: Single write SetPadds;
  end;

  //Положение объекта
  TCtrlAlign = (alNone, alTop, alBottom, alLeft, alRight, alClient, alCenter);
  //Положение текста
  TGuiHAlignment = (tahLeft, tahRigth, tahCenter, tahJustify);
  TGuiVAlignment = (tavTop, tavCenter, tavBottom);

  //Декларация наперед для мышиных эвентов
  zglTCtrl = class;
  //Мышиные вызовы
  TMouseEvent     = procedure (Sender: zglTCtrl; MouseButton: Cardinal);
  TMouseEventO    = procedure (Sender: zglTCtrl; MouseButton: Cardinal) of object;
  TMouseMoveEvent = procedure (Sender: zglTCtrl);

  TKeyShift  = set of (ssShift, ssAlt, ssCtrl);
  TKeyEvent  = procedure(Sender: zglTCtrl; var Key: Byte; Shift: TKeyShift);
  TKeyCharEvent = procedure (Sender: zglTCtrl; var Key: Char; Shift: TKeyShift);
  TKeyEventO = procedure(Sender: zglTCtrl; Key: Byte) of object;

  TCtrlUpdateEvent = procedure (Sender: zglTCtrl; dt: Double);
  TCtrlDrawEvent = procedure (Sender: zglTCtrl);




  //Гуи объект пустышка
  zglTCtrl = class
  private
    aType: Cardinal;      //Тип гуи объекта   (USELESS)
    aUsrRect: zglTRect;   //ББ, устанавливаемый пользователем
    aRect: zglTRect;      //Действительный ББ
    aRectDraw: Boolean;   //Рисовать ББ
    aRectClr: TRGBColor;  //Цвет ББ
    useCntr: Integer;     //Счетчик использования, чтобы не было проблем при высвобождении
    aParent: zglTCtrl;    //Подлежащий ГУИ
    aPWinRect: zglPRect;  //ББ Окна для позиционирования
    aAlign: TCtrlAlign;   //!!Новое положение
    aVisible: Boolean;    //Отображается ли контрол
    aEnabled: Boolean;    //Работает ли контрол
    aFont: zglPFont;      //Чем писать по контролу
    aFontClr: TRGBColor;  //Цвет текста
    aPadding: TPadding;   //Внутреннее отталкивание
    aChilds: TList;       //Посаженые потомки

    //Эвенты
    aMouseEnter: Boolean;
    aMouseEnterEvent: TMouseMoveEvent;
    aMouseLeaveEvent: TMouseMoveEvent;

    aMouseDown: Boolean;
    aWaitRelease: Boolean;  //Если мышь вошла нажатой
    aMouseDownEvent: TMouseEvent;
    aMouseUpEvent:   TMouseEvent;


    aKeyShit: TKeyShift;          //Состояние контрольных клавиш
    aKeyDownProc: TKeyEvent;      //Callback пользовательских обработчиков клавиш
    aKeyPressProc: TKeyCharEvent;
    aKeyUpProc: TKeyEvent;

    aOnDraw:   TCtrlDrawEvent;
    aOnUpdate: TCtrlUpdateEvent;

    procedure SetParent(Val: zglTCtrl);
    procedure Draw();             virtual;
    procedure Update(dt: Double); virtual;
    procedure AlignChilds();
    procedure AddChild(Child: zglTCtrl);
    procedure DelChild(Child: zglTCtrl);
    //задаем размеры и пересчитываем положения
    procedure SetPosX(Val: Single);
    procedure SetPosY(Val: Single);
    procedure SetWidth(Val: Single);
    procedure SetHeight(Val: Single);
    procedure SetAlign(Val: TCtrlAlign);
    procedure Assign(Src: zglTCtrl); virtual;
    function GetEnabled: Boolean;
    function GetVisible: Boolean;

    procedure aOnKeyDown(var Key: Byte); virtual;
    procedure aOnKeyPress(var Key: Char); virtual;
    procedure aOnKeyUp(var Key: Byte); virtual;

    procedure aOnMouseEnter(Sender: zglTCtrl); virtual;
    procedure aOnMouseLeave(Sender: zglTCtrl); virtual;
    procedure aOnMouseDown(Sender: zglTCtrl; MouseButton: Cardinal); virtual;
    procedure aOnMouseUp(Sender: zglTCtrl; MouseButton: Cardinal); virtual;
  public
    constructor Create(ParentCtrl: zglTCtrl);
    destructor Destroy; override;
    procedure SendFront(); //Позиционирование относительно других контролов
    procedure SendBack();
    property Left: Single      read aUsrRect.X write SetPosX;
    property Top: Single      read aUsrRect.Y write SetPosY;
    property Width: Single  read aRect.W write SetWidth;
    property Height: Single read aRect.H write SetHeight;
    property Align: TCtrlAlign read aAlign write SetAlign;
    property Parent: zglTCtrl read aParent write SetParent;
    property Visible: Boolean read GetVisible write aVisible;
    property Enabled: Boolean read GetEnabled write aEnabled;
    property Font: zglPFont read aFont write aFont;
    property FontColor: Cardinal read aFontClr.argb write aFontClr.argb;
    property OnMouseEnter: TMouseMoveEvent write aMouseEnterEvent;
    property OnMouseLeave: TMouseMoveEvent write aMouseLeaveEvent;
    property OnMouseDown: TMouseEvent write aMouseDownEvent;
    property OnMouseUp:   TMouseEvent write aMouseUpEvent;
    property Padding: TPadding read aPadding write aPadding;
    property BBDraw: Boolean read aRectDraw write aRectDraw;
    property BBColor: Cardinal read aRectClr.argb write aRectClr.argb;
    property OnDraw: TCtrlDrawEvent read aOnDraw write aOnDraw;
    property OnUpdate: TCtrlUpdateEvent read aOnUpdate write aOnUpdate;
  end;


  //Панелька
  zglTPanel = class(zglTCtrl)
  private
    aColor: TRGBColor;
    aBorder: Boolean;
    aBorderColor: TRGBColor;
    procedure Draw(); override;
  public
    constructor Create(ParentCtrl: zglTCtrl; Color: Cardinal = $00FFFFFF);
    procedure Assign(Src: zglTPanel);
    property Color: Cardinal read aColor.argb write aColor.argb;
    property Border: Boolean read aBorder write aBorder;
    property BorderColor: Cardinal read aBorderColor.argb write aBorderColor.argb;
  end;

  //Надпись
  zglTLabel = class(zglTCtrl)
  private
    aText: string;
    aAlignmentH: TGuiHAlignment;
    aAlignmentV: TGuiVAlignment;
    aScale: Single;
    procedure Draw(); override;
  public
    constructor Create(ParentCtrl: zglTCtrl; Text: string; Color: Cardinal = $FF000000);
    property AlignmentH: TGuiHAlignment read aAlignmentH write aAlignmentH;
    property AlignmentV: TGuiVAlignment read aAlignmentV write aAlignmentV;
    property Text: string read aText write aText;
    property Scale: Single read aScale write aScale;
  end;

  //Вводилка текста
  zglTEdit = class(zglTCtrl)
  private
    aText: string;
    aActive: Boolean;  //Считывает ввод с клавы или нет
    LeftSym: Integer;  //левый символ от которого рисуется
    CaretSym: Integer; //на каком символе каретка
    WinkTimeout: Cardinal; //таймаут на моргание
    WinkCntr: Double;      //счетчкик на моргание
    Winked: Boolean;       //Моргает
    aMaxChar: Cardinal;
    procedure Draw(); override;
    procedure Update(dt: Double); override;
//    procedure OnSelect(Sender: zglTCtrl; MouseButton: Cardinal);
    procedure aOnMouseDown(Sender: zglTCtrl; MouseButton: Cardinal); override;
    procedure SetActive(Val: Boolean);
    function GetActive(): Boolean;
    procedure SetText(Val: string);
    procedure SetMaxChar(Val: Cardinal);
    procedure aOnKeyDown(var Key: Byte); override;
    procedure aOnKeyPress(var Key: Char); override;
  public
    constructor Create(ParentCtrl: zglTCtrl);
    property Acitve: Boolean read GetActive write SetActive;
    property Text: string read aText write SetText;
    property MaxChars: Cardinal read aMaxChar write SetMaxChar;
  end;

  //Картинка
  zglTImage = class(zglTCtrl)
  private
    aTex: zglPTexture;
    aBlendColor: TRGBColor;
    aStretched: Boolean;
    aCentred: Boolean;
    procedure Draw(); override;
  public
    constructor Create(ParentCtrl: zglTCtrl; Texture: zglPTexture);
    property BlendColor: Cardinal read aBlendColor.argb write aBlendColor.argb;
    property Stretch: Boolean read aStretched write aStretched;
    property Centr: Boolean read aCentred write aCentred;
  end;

  //Батон
  zglTButton = class(zglTCtrl)
  private
    aTex: zglPTexture;  //Графика объекта
    aTexFrame: Integer; //Кадр текстуры, по умолчанию 1
    aText: string;
    aDown: Boolean;     //Вжата
    aCanDown: Boolean;
    procedure Draw(); override;
    procedure aOnMouseEnter(Sender: zglTCtrl); override;
    procedure aOnMouseLeave(Sender: zglTCtrl); override;
    procedure aOnMouseDown(Sender: zglTCtrl; MouseButton: Cardinal); override;
    procedure aOnMouseUp(Sender: zglTCtrl; MouseButton: Cardinal); override;
    procedure SetADown(Val: Boolean);
  public
    constructor Create(ParentCtrl: zglTCtrl; Tex: zglPTexture; Text: String = '');
    procedure Assign(Src: zglTButton);
    property Text: string read aText write aText;
    property CanDown: Boolean read aCanDown write aCanDown;
    property Down: Boolean read aDown write SetADown;
  end;

  //Список
  TListBoxItem = class
    Text: string;
  end;

  TLBItemList = class(TList)
    function Add(Text: string): Integer;
    function Get(Index: Integer): string;
    destructor Destroy; override;
  end;
{
  zglTListBox = class(zglTCtrl)
  private
    aItems : TLBItemList;
    aTopItemInd: Integer;
    aSelItemInd: Integer;
    aCount: Integer;

    aRect: zglTRect;
    aPadding: Integer;
    aItmRect: zglTRect;
    aItmPadd: Integer;

    aBgTex: zglPTexture;
    aBgCol: Cardinal;

    aFont: zglPFont;

    procedure Draw(); override;
    procedure Update(dt: Double); override;
    function MaxCapacity(): Integer;
  public
    constructor Create(ParentCtrl: zglTCtrl; Rect: zglPRect; Font: zglPFont; BgTex: zglPTexture; BgColor: Cardinal = $0);
    destructor Destroy; override;
    procedure Add(Text: string);
  end;
}

  //Менеджер контролов
  zglTGUI = class(zglTCtrl)
  private
    aWinRect: zglTRect;
  public
    procedure Draw(); override;
    procedure Update(dt: Double); override;
    constructor Create(WindowW, WindowH: Single; Font: zglPFont);
    property OnKeyDown: TKeyEvent write aKeyDownProc;
    property OnKeyPress: TKeyCharEvent write aKeyPressProc;
    property OnKeyUp: TKeyEvent write aKeyUpProc;
  end;

  //Обязательная процедура для иннициализации перехвата ввода с ZenGL
  procedure zglInitInput();

implementation

type
  //Передатчик от zenGL к контролам
  zenTInputIntfs = class(TList)
  private
    anActiveControl: zglTEdit; //Контрол, работающий самостоятельно
  public
    procedure CallKD(KeyCode : Byte);
    procedure CallKP(Symbol : String);
    procedure CallKU(KeyCode : Byte);
  end;

var
  zenII: zenTInputIntfs;


procedure TPadding.SetPadds(Val: Single);
begin
  aTop := Val;
  aBottom := Val;
  aLeft := Val;
  aRight := Val;
end;

constructor TPadding.Create;
begin
  aTop := 0;
  aBottom := 0;
  aLeft := 0;
  aRight := 0;
end;


//*******************
// TGuiObject
//*******************

procedure zglTCtrl.SetParent(Val: zglTCtrl);
begin
  if (aParent <> nil) then
    aParent.DelChild(Self);

  aParent := Val;

  if (aParent <> nil) then
  begin
    if (aUsrRect.W = 0) and (aUsrRect.H = 0) then
      aUsrRect := aParent.aUsrRect;

    aFont := aParent.Font;
    aParent.AddChild(Self);
    aParent.AlignChilds();
  end;
end;

constructor zglTCtrl.Create(ParentCtrl: zglTCtrl);
begin
  inherited Create;
  useCntr := -1;
  aAlign := alNone;
  aPWinRect := nil;
  aParent := nil;
  aUsrRect.X := 0;
  aUsrRect.Y := 0;
  aUsrRect.W := 0;//100;
  aUsrRect.H := 0;//50;
  aVisible := True;
  aEnabled := True;
  aFontClr.argb := $FFFFFFFF;
  aChilds := TList.Create;
  SetParent(ParentCtrl);

  aPadding := TPadding.Create;

  if aParent <> nil then
  begin
    aFont := aParent.Font;
  end;
  aRectDraw := False;
  aRectClr.argb := $FF888888;
end;

destructor zglTCtrl.Destroy;
var
  i: Integer;
begin
  Parent := nil;
  with aChilds do
  begin
    for i := 0 to aChilds.Count - 1 do
      if (Assigned(Items[i])) then
      begin
        //Зарание вычищаем парента у дитя, чтобы не тревожил этот контрол
        zglTCtrl(Items[i]).aParent := nil;
        zglTCtrl(Items[i]).Free
      end;
  end;
  aChilds.Free;
  aPadding.Free;
end;

procedure zglTCtrl.SendFront();
var
  i: Integer;
  p: zglTCtrl;
begin
  if aParent = nil then
    Exit;
  p := aParent;
  //Если уже наверху
  if Self = p.aChilds.Items[p.aChilds.Count - 1] then
    Exit;

  for i := 0 to p.aChilds.Count - 1 do
    if p.aChilds.Items[i] = Self then
    begin
      p.aChilds.Del(i);
      p.aChilds.Add(Self);
    end;

  p.AlignChilds();
end;

procedure zglTCtrl.SendBack();
var
  i: Integer;
  p: zglTCtrl;
begin
  if aParent = nil then
    Exit;
  p := aParent;
  //Если уже внизу
  if Self = p.aChilds.Items[0] then
    Exit;

  for i := 0 to p.aChilds.Count - 1 do
    if p.aChilds.Items[i] = Self then
    begin
      p.aChilds.Del(i);
      p.aChilds.Insert(0, Self);
    end;

  p.AlignChilds();
end;

procedure zglTCtrl.Draw();
var
  i: Integer;
begin
  if aRectDraw then
    pr2d_Rect(aRect.X, aRect.Y, aRect.W, aRect.H, aRectClr.argb, aRectClr.A);

  for i := 0 to aChilds.Count - 1 do
  begin
    if not zglTCtrl(aChilds.Items[i]).Visible then
      Continue;
    zglTCtrl(aChilds.Items[i]).Draw;
  end;

  if Assigned(aOnDraw) then
    aOnDraw(Self);

end;

procedure zglTCtrl.Update(dt: Double);
var
  AnyDown: Boolean;
  i: Integer;
begin
  //Возможно этого не надо
  //if (Parent <> nil) and (not Parent.Enabled) then
  //  Exit;

  //Если мы отключены
//  if (not aEnabled) or (not Visible) then
//    Exit
  for i := 0 to aChilds.Count - 1 do  
  begin
    if (not zglTCtrl(aChilds.Items[i]).Visible) or
       (not zglTCtrl(aChilds.Items[i]).Enabled) then
      Continue;
    zglTCtrl(aChilds.Items[i]).Update(dt);
  end;


//-------------МЫШЬ--------

  //Пусть будет только левая кнопка
  //TODO: Попробовать разогнать процедурку побыстрее
  AnyDown := mouse_Down(M_BLEFT);// or mouse_Down(M_BMIDDLE) or mouse_Down(M_BRIGHT);

  //Генерация он Энтер
  if col2d_PointInRect(mouse_X, mouse_Y, aRect) then
  begin
    //вызываем процедуру что мышь зашла
    if not aMouseEnter then
    begin
      aOnMouseEnter(Self);
      if AnyDown then
        aWaitRelease := True;
    end;

    if not AnyDown then
      aWaitRelease := False;
    aMouseEnter := True;
  end
  else
  begin
    if aMouseEnter then
      aOnMouseLeave(Self);
    aMouseEnter := False;
    //сбрасываем состояние нажатости, если не нажета
    if aMouseDown then
      aMouseDown := False;
  end;

  //
  if (aWaitRelease) then
    Exit;

  //Генерация он Даун и он Ап
  if aMouseEnter then
  begin
    if AnyDown then
    begin
      if not aMouseDown then
        aOnMouseDown(Self, M_BLEFT);
      aMouseDown := True;
    end
    else
    begin
      if aMouseDown then
        aOnMouseUp(Self, M_BLEFT);
      aMouseDown := False
    end;
  end;

  if Assigned(aOnUpdate) then
    aOnUpdate(Self, dt);
end;

procedure zglTCtrl.AlignChilds();
var
  i: Integer;
  tr: zglTRect;
  gc: zglTCtrl;
begin
  tr := aRect;
  if aPadding.Top <> 0 then
  begin
    tr.Y := tr.Y + aPadding.Top;
    tr.H := tr.H - aPadding.Top;
  end;
  if aPadding.Bottom <> 0 then
    tr.H := tr.H - aPadding.Bottom;
  if aPadding.Left <> 0 then
  begin
    tr.X := tr.X + aPadding.Left;
    tr.W := tr.W - aPadding.Left;
  end;
  if aPadding.Right <> 0 then
    tr.W := tr.W - aPadding.Right;


  for i := 0 to aChilds.Count - 1 do
  begin
    //TODO: Выравнивание деток
    gc := zglTCtrl(aChilds.Items[i]);

    case gc.aAlign of
      alNone: begin
        gc.aRect.X := aRect.X + gc.aUsrRect.X;
        gc.aRect.Y := aRect.Y + gc.aUsrRect.Y;
        gc.aRect.W := gc.aUsrRect.W;
        gc.aRect.H := gc.aUsrRect.H;
      end;
      alTop: begin
        gc.aRect.X := tr.X;
        gc.aRect.Y := tr.Y;
        gc.aRect.W := tr.W;
        gc.aRect.H := gc.aUsrRect.H;
        tr.Y := tr.Y + gc.aUsrRect.H;
        tr.H := tr.H - gc.aUsrRect.H;
      end;
      alBottom: begin
        gc.aRect.X := tr.X;
        gc.aRect.Y := tr.Y + tr.H - gc.aUsrRect.H;
        gc.aRect.W := tr.W;
        gc.aRect.H := gc.aUsrRect.H;
        tr.H := tr.H - gc.aUsrRect.H;
      end;
      alLeft: begin
        gc.aRect.X := tr.X;
        gc.aRect.Y := tr.Y;
        gc.aRect.H := tr.H;
        gc.aRect.W := gc.aUsrRect.W;
        tr.X := tr.X + gc.aUsrRect.W;
        tr.W := tr.W - gc.aUsrRect.W;
      end;
      alRight: begin
        gc.aRect.X := tr.X + tr.W - gc.aUsrRect.W;
        gc.aRect.Y := tr.Y;
        gc.aRect.H := tr.H;
        gc.aRect.W := gc.aUsrRect.W;
        tr.W := tr.W - gc.aUsrRect.W;
      end;
      alClient: begin
        gc.aRect.X := tr.X;
        gc.aRect.Y := tr.Y;
        gc.aRect.W := tr.W;
        gc.aRect.H := tr.H;
        tr.W := 0;
        tr.H := 0;
      end;
      alCenter: begin
        //TODO: Центральное положение
        gc.aRect.X := aRect.X + (aRect.W / 2 - gc.aUsrRect.W / 2);
        gc.aRect.Y := aRect.Y + (aRect.H / 2 - gc.aUsrRect.H / 2);
        gc.aRect.W := gc.aUsrRect.W;
        gc.aRect.H := gc.aUsrRect.H;
      end;
    end;
  end;
end;

procedure zglTCtrl.AddChild(Child: zglTCtrl);
begin
  aChilds.Add(Child);
end;

procedure zglTCtrl.DelChild(Child: zglTCtrl);
var
  i: Integer;
begin
  for i := 0 to aChilds.Count - 1 do
    if aChilds.Items[i] = Child then
    begin
      aChilds.Del(i);
      Break;
    end;
end;

procedure zglTCtrl.SetPosX(Val: Single);
begin
  aUsrRect.X := Val;
  if Parent <> nil then
    Parent.AlignChilds();
  AlignChilds();
end;

procedure zglTCtrl.SetPosY(Val: Single);
begin
  aUsrRect.Y := Val;
  if Parent <> nil then
    Parent.AlignChilds();
  AlignChilds();
end;

procedure zglTCtrl.SetWidth(Val: Single);
begin
  aUsrRect.W := Val;
  if Parent <> nil then
    Parent.AlignChilds();
  AlignChilds();
end;

procedure zglTCtrl.SetHeight(Val: Single);
begin
  aUsrRect.H := Val;
  if Parent <> nil then
    Parent.AlignChilds();
  AlignChilds();
end;

procedure zglTCtrl.SetAlign(Val: TCtrlAlign);
begin
  aAlign := Val;
  if Parent <> nil then
    Parent.AlignChilds();
  AlignChilds();
end;

procedure zglTCtrl.Assign(Src: zglTCtrl);
begin
  aType := Src.aType;
  aUsrRect := Src.aUsrRect;
  aRect := Src.aRect;
  useCntr := Src.useCntr;
//  SetParent(Src.aParent); //Парента не стоит красть
  aPWinRect := Src.aPWinRect;
  aAlign := Src.aAlign;
  aVisible := Src.aVisible;
  aEnabled := Src.Enabled;
  aFont := Src.aFont;
  aFontClr := Src.aFontClr;
  aPadding.Top := Src.aPadding.Top;
  aPadding.Bottom := Src.aPadding.Bottom;
  aPadding.Left := Src.aPadding.Left;
  aPadding.Right := Src.aPadding.Right;

  aMouseEnterEvent := Src.aMouseEnterEvent;
  aMouseLeaveEvent := Src.aMouseLeaveEvent;

  aMouseDownEvent := Src.aMouseDownEvent;
  aMouseUpEvent := Src.aMouseUpEvent;

//  aChilds := Src.aChilds; //Нельзя забирать чужих
  if aParent <> nil then
    aParent.AlignChilds();
end;

function zglTCtrl.GetEnabled: Boolean;
var
  p: zglTCtrl;
begin
  Result := aEnabled;
  p := Parent;
  while p <> nil do
  begin
    Result := p.aEnabled;
    p := p.Parent;
  end;
end;

function zglTCtrl.GetVisible: Boolean;
var
  p: zglTCtrl;
begin
  Result := aVisible;
  if not Result then
    Exit;

  p := Parent;
  while p <> nil do
  begin
    Result := p.aVisible;
    if not Result then
      Exit;
    p := p.Parent;
  end;
end;

procedure zglTCtrl.aOnKeyDown(var Key: Byte);
begin
  case Key of
    K_SHIFT, K_SHIFT_L, K_SHIFT_R : aKeyShit := aKeyShit + [ssShift];
    K_CTRL,  K_CTRL_L,  K_CTRL_R  : aKeyShit := aKeyShit + [ssCtrl];
    K_ALT,   K_ALT_L,   K_ALT_R   : aKeyShit := aKeyShit + [ssAlt];
  end;
  if Assigned(aKeyDownProc) then
    aKeyDownProc(Self, Key, aKeyShit);

end;

procedure zglTCtrl.aOnKeyPress(var Key: Char);
begin
  if Assigned(aKeyPressProc) then
    aKeyPressProc(Self, Key, aKeyShit);
end;

procedure zglTCtrl.aOnKeyUp(var Key: Byte);
begin
  case Key of
    K_SHIFT, K_SHIFT_L, K_SHIFT_R : aKeyShit := aKeyShit - [ssShift];
    K_CTRL,  K_CTRL_L,  K_CTRL_R  : aKeyShit := aKeyShit - [ssCtrl];
    K_ALT,   K_ALT_L,   K_ALT_R   : aKeyShit := aKeyShit - [ssAlt];
  end;
  if Assigned(aKeyUpProc) then
    aKeyUpProc(Self, Key, aKeyShit);
end;

procedure zglTCtrl.aOnMouseEnter(Sender: zglTCtrl);
begin
  if Assigned(aMouseEnterEvent) then
    aMouseEnterEvent(Self);
end;

procedure zglTCtrl.aOnMouseLeave(Sender: zglTCtrl);
begin
  if Assigned(aMouseLeaveEvent) then
    aMouseLeaveEvent(Self);
end;

procedure zglTCtrl.aOnMouseDown(Sender: zglTCtrl; MouseButton: Cardinal);
begin
  if Assigned(aMouseDownEvent) then
    aMouseDownEvent(Self, MouseButton);
end;

procedure zglTCtrl.aOnMouseUp(Sender: zglTCtrl; MouseButton: Cardinal);
begin
  if Assigned(aMouseUpEvent) then
    aMouseUpEvent(Self, MouseButton);
end;






//*******************
// TGuiPanel
//*******************

constructor zglTPanel.Create(ParentCtrl: zglTCtrl; Color: Cardinal = $00FFFFFF);
begin
  inherited Create(ParentCtrl);

  aColor.argb := Color;
  aBorder := False;
  aBorderColor.argb := $FF000000;
end;

procedure zglTPanel.Assign(Src: zglTPanel);
begin
  inherited Assign(Src);
  aColor       := Src.aColor;
  aBorder      := Src.aBorder;
  aBorderColor := Src.aBorderColor;
end;

procedure zglTPanel.Draw();
begin
  pr2d_Rect(aRect.X, aRect.Y, aRect.W, aRect.H, aColor.argb, aColor.A, PR2D_FILL);
  if Border then
    pr2d_Rect(aRect.X, aRect.Y, aRect.W, aRect.H, aBorderColor.argb, aBorderColor.A);

  inherited;
end;





//*******************
// TGuiText
//*******************

constructor zglTLabel.Create(ParentCtrl: zglTCtrl; Text: string; Color: Cardinal = $FF000000);
begin
  inherited Create(ParentCtrl);
  aAlignmentH := tahLeft;
  aAlignmentV := tavTop;
  aText := Text;
  aFontClr.argb := Color;
  Width := text_GetWidth(aFont, Text);
  aScale := 1;
end;

procedure zglTLabel.Draw();
var
  resAl: Cardinal;
begin
  case aAlignmentH of
    tahLeft:    resAl := TEXT_HALIGN_LEFT;
    tahCenter:  resAl := TEXT_HALIGN_CENTER;
    tahRigth:   resAl := TEXT_HALIGN_RIGHT;
    tahJustify: resAl := TEXT_HALIGN_JUSTIFY;
  end;
  case aAlignmentV of
    tavTop:    resAl := resAl or TEXT_VALIGN_TOP;
    tavCenter: resAl := resAl or TEXT_VALIGN_CENTER;
    tavBottom: resAl := resAl or TEXT_VALIGN_BOTTOM;
  end;

  text_DrawInRectEx(aFont, aRect, aScale, 0, aText, aFontClr.A, aFontClr.argb, resAl);

  inherited;
end;





//*******************
// TGuiEdit
//*******************

procedure zglTEdit.Draw();
var
  s: string;
  tw, w: Single;
begin
  //обрезаем слева
  if LeftSym <> 0 then
  begin
    s := Copy(aText, LeftSym, Length(aText));
  end
  else
  begin
    s := aText;
  end;
  //Обрезаем справа
  while text_GetWidth(Font, s) > aRect.W do
    Delete(s, Length(s), 1);
  //рисуем что осталось
  text_DrawInRectEx(aFont, aRect, 1, 0, s, aFontClr.A, aFontClr.argb,
    TEXT_HALIGN_LEFT or TEXT_VALIGN_CENTER or TEXT_HALIGN_JUSTIFY);

  //каретка
  if CaretSym > Length(aText) then
  begin
//    cPos := 0;
    tw := text_GetWidth(Font, s);
    w := text_GetWidth(Font, 'A');
  end
  else
  begin
    //Символы до каретки
    s := Copy(aText, LeftSym, (CaretSym + LeftSym) - 1);
    tw := text_GetWidth(Font, s);
    //Символ вхождения
    s := Copy(aText, (CaretSym + LeftSym), 1);
    w := text_GetWidth(Font, s);
  end;
  if (aRect.X + tw + w) > (aRect.X + aRect.W) then
    w := aRect.W - tw - 1;
  if w < 0 then
    w := 0;
  if Winked then
    pr2d_Rect(tw + aRect.X + 1, aRect.Y, w, aRect.H, $FFFFFF, $88, PR2D_FILL);
  pr2d_Rect(tw + aRect.X + 1, aRect.Y, w, aRect.H, $000000, $FF);

  inherited;
end;

procedure zglTEdit.Update(dt: Double);
begin
  inherited;
  if not Acitve then
    Exit;

  WinkCntr := WinkCntr + dt;
  if WinkCntr > WinkTimeout then
  begin
    WinkCntr := 0;
    Winked := not Winked;
  end;



end;

procedure zglTEdit.aOnMouseDown(Sender: zglTCtrl; MouseButton: Cardinal);
begin
  inherited;
  if zenII.anActiveControl <> Self then
    zenII.anActiveControl := Self;
end;

procedure zglTEdit.SetActive(Val: Boolean);
begin
  aActive := Val;
  if aActive then
  begin
    if zenII.anActiveControl <> Self then
      zenII.anActiveControl := Self;
  end
  else
  begin
    if zenII.anActiveControl = Self then
      zenII.anActiveControl := nil;
  end;
end;

function zglTEdit.GetActive(): Boolean;
begin
  if (aActive) and (Enabled) and (Visible) then
    Result := True
  else
    Result := False;
end;

procedure zglTEdit.SetText(Val: string);
begin
  aText := Val;
  CaretSym := Length(aText) + 1;
end;

procedure zglTEdit.SetMaxChar(Val: Cardinal);
begin
  aMaxChar := Val;
  //Уменьшаем кол-во символов, если их слишком много
  if Length(aText) > MaxChars then
    aText := Copy(aText, 1, MaxChars)
end;

procedure zglTEdit.aOnKeyDown(var Key: Byte);
begin
  inherited;

  if Key = K_BACKSPACE then
  begin
    if CaretSym > Length(Text) then
      aText := Copy(aText, 1, Length(aText) - 1)
    else
      Delete(aText, CaretSym - 1, 1);
    Dec(CaretSym);
    if CaretSym = 0 then
      CaretSym := 1;
  end;
  if Key = K_DELETE then
  begin
    Delete(aText, CaretSym, 1);

  end;
  if (Key = K_LEFT) and (CaretSym <> 1) then
    Dec(CaretSym);
  if (Key = K_RIGHT) and (CaretSym < Length(aText) + 1) then
    Inc(CaretSym);
  if (Key = K_HOME) then
    CaretSym := 1;
  if (Key = K_END) then
    CaretSym := Length(Text) + 1;
end;

procedure zglTEdit.aOnKeyPress(var Key: Char);
begin
  inherited;

  //Избегаем переноса
  if text_GetWidth(Font, aText + Key) >= (aRect.W - 1) then
    Exit;

  if CaretSym > Length(aText) then
    aText := aText + Key
  else
    Insert(Key, aText, CaretSym);
  Inc(CaretSym);
end;

constructor zglTEdit.Create(ParentCtrl: zglTCtrl);
const
  tTetxt = 'Iljg';
var
  w: Single;
begin
  inherited;
  LeftSym := 0;
  CaretSym := 1;
  w := text_GetWidth(Font, tTetxt);
  Height := text_GetHeight(aFont, w, tTetxt);
//  aKeyDownOProc := OnKeyDown;
//  aMouseDownEventO := OnSelect;
  Acitve := True;
  WinkTimeout := 500;
  WinkCntr := 0;
  aMaxChar := 0;
  //Регистрируем контрол на обработку клавы
  zenII.Add(Self);
//  anActiveControl := Self;
end;



//*******************
// TGuiImage
//*******************

procedure zglTImage.Draw();
var
  tR: zglTRect;
begin
  tR.X := aRect.X;
  tR.Y := aRect.Y;
  if aStretched then
  begin
    tR.W := aRect.W;
    tR.H := aRect.H;
  end
  else
  begin
    tr.W := aTex.Width;
    tr.H := aTex.Height;
    if aCentred then
    begin
      tR.X := aRect.X + (aRect.W / 2 - tr.W / 2);
      tR.Y := aRect.Y + (aRect.H / 2 - tr.H / 2);
    end;
  end;

  if aBlendColor.argb = $FFFFFFFF then
    ssprite2d_Draw(aTex, tR.X, tR.Y, tR.W, tR.H, 0)
  else
  begin
    fx2d_SetColor(aBlendColor.argb);
    ssprite2d_Draw(aTex, tR.X, tR.Y, tR.W, tR.H, 0,
      aBlendColor.A, FX_BLEND or FX_COLOR
    );
  end;

  inherited;
end;

constructor zglTImage.Create(ParentCtrl: zglTCtrl; Texture: zglPTexture);
begin
  inherited Create(ParentCtrl);
  aBlendColor.argb := $FFFFFFFF;
  Stretch := False;
  Centr := False;
  if Texture <> nil then
  begin
    Width := Texture.Width;
    Height := Texture.Height;
    aTex := Texture;
  end;
end;




//*******************
// TGuiButton
//*******************

constructor zglTButton.Create(ParentCtrl: zglTCtrl; Tex: zglPTexture; Text: String = '');
begin
  inherited Create(ParentCtrl);
  aTex := Tex;
  aText := Text;
  Width := 75;
  Height := 25;

//  aFont := Font;
  aTexFrame := 1;
  aWaitRelease := False;
  aMouseEnter := False;               //ТЕКСТ НА КНОПКЕ???
  aMouseDown := False;
  aType := GUITYPE_BUTTON;
  aDown := False;
  aCanDown := False;
end;

procedure zglTButton.Assign(Src: zglTButton);
begin
  inherited Assign(Src);
  aTex := Src.aTex;
//  aTexFrame := Src.aTexFrame;
  aText := Src.aText;
end;

procedure zglTButton.Draw();
begin
  if aTex <> nil then
    asprite2d_Draw(aTex, aRect.X, aRect.Y, aRect.W, aRect.H, 0, aTexFrame);
  if aFont <> nil then
    text_DrawInRectEx(aFont, aRect, 1, 0, aText, $FF, aFontClr.argb, TEXT_HALIGN_CENTER or TEXT_VALIGN_CENTER);
  inherited;
end;

procedure zglTButton.aOnMouseEnter(Sender: zglTCtrl);
begin
  inherited;
  if not aDown then
    aTexFrame := 3
  else
    aTexFrame := 2;
end;

procedure zglTButton.aOnMouseLeave(Sender: zglTCtrl);
begin
  inherited;
  if not aDown then
    aTexFrame := 1
  else
    aTexFrame := 2;
end;

procedure zglTButton.aOnMouseDown(Sender: zglTCtrl; MouseButton: Cardinal);
begin
  inherited;
  if (MouseButton = M_BLEFT) then
  begin
    if aCanDown then
      aDown := not aDown;

    if aDown then
      aTexFrame := 1
    else
      aTexFrame := 2;
  end;
end;

procedure zglTButton.aOnMouseUp(Sender: zglTCtrl; MouseButton: Cardinal);
begin
  inherited;
  if (MouseButton = M_BLEFT) then
    if aDown then
      aTexFrame := 2
    else
      aTexFrame := 1;
end;

procedure zglTButton.SetADown(Val: Boolean);
begin
  if CanDown then
  begin
    aDown := Val;
    if aDown then
      aTexFrame := 2
    else
      aTexFrame := 1;
  end;
end;


//*******************
// TLBItemList
//*******************

function TLBItemList.Add(Text: string): Integer;
var
  li: TListBoxItem;
begin
  li := TListBoxItem.Create;
  li.Text := Text;
  Result := inherited Add(li);
end;

function TLBItemList.Get(Index: Integer): string;
begin
  Result := TListBoxItem(inherited Get(Index)).Text;
end;

destructor TLBItemList.Destroy;
var
  i: Integer;
begin
  for i := 0 to FCount - 1 do
    TListBoxItem(FItems[i]).Free;
  inherited;
end;




//*******************
// TGuiListBox
//*******************

{
procedure zglTListBox.Draw();
var
  i: Integer;
  s: string;
  tR: zglTRect;
begin
  //Бокс
  if aBgTex = nil then
    pr2d_Rect(aRect.X, aRect.Y, aRect.W, aRect.H, aBgCol, $FF, PR2D_FILL)
  else
    asprite2d_Draw(aBgTex, aRect.X, aRect.Y, aRect.W, aRect.H, 0, 0);

  //Содержимое
  for i := 0 to MaxCapacity - 1 do
  begin
    s := aItems.Get(i);
    tR := aItmRect;
    tR.X := aRect.X + aPadding;
    if i = 0 then
      tR.Y := aRect.Y + aPadding
    else
      tR.Y := aRect.Y + aPadding + (tR.H + aItmPadd) * i;
    pr2d_Rect(tR.X, tR.Y, tR.W, tR.H, $FFFFFF, $FF, PR2D_FILL);
    text_DrawInRectEx(aFont, tR, 1, 0, s, $FF, $FF0000, TEXT_HALIGN_CENTER or TEXT_VALIGN_CENTER);
  end;
  inherited;
end;

procedure zglTListBox.Update(dt: Double);
begin

end;

function zglTListBox.MaxCapacity(): Integer;
begin
  Result := Round(arect.H - aPadding * 2) div Round(aItmRect.H + aItmPadd);
end;

constructor zglTListBox.Create(ParentCtrl: zglTCtrl; Rect: zglPRect; Font: zglPFont; BgTex: zglPTexture; BgColor: Cardinal = $0);
const
  sampleText: string = 'HelloAJQqgO';
var
  tW: Single;
begin
  inherited Create(ParentCtrl);
  aItems := TLBItemList.Create;

  if Rect <> nil then
    aRect := Rect^;
  aBgTex := BgTex;
  aBgCol := BgColor;
  aFont := Font;
  aPadding := 10;
  aItmPadd := 5;
  if aFont <> nil then
  begin
    aItmRect.W := aRect.W - aPadding * 2;
    tW := text_GetWidth(Font, sampleText);
    aItmRect.H := text_GetHeight(Font, tW, sampleText) + aItmPadd * 2;
  end;

end;

destructor zglTListBox.Destroy;
begin
  aItems.Free;
end;

procedure zglTListBox.Add(Text: string);
begin
  aItems.Add(Text);
end;     }




//*******************
// TGUI
//*******************
procedure zglTGUI.Draw;
begin
  inherited Draw;
end;

procedure zglTGUI.Update(dt: Double);
begin
  inherited Update(dt);
end;

constructor zglTGUI.Create(WindowW, WindowH: Single; Font: zglPFont);
begin
  inherited Create(nil);
  aWinRect.X := 0;
  aWinRect.Y := 0;
  aWinRect.W := WindowW;
  aWinRect.H := WindowH;
  aRect.W := WindowW;
  aRect.H := WindowH;
  aUsrRect := aRect;
  aFont := Font;

  zenII.Add(Self)
end;







//*******************
// zenTInputIntfs
//*******************

procedure zenTInputIntfs.CallKD(KeyCode : Byte);
var
  i: Integer;
  Key: Byte;
begin
  Key := KeyCode;
  for i := 0 to FCount - 1 do
    if zglTCtrl(FItems[i]).Enabled then
      zglTCtrl(FItems[i]).aOnKeyDown(Key);
end;

procedure zenTInputIntfs.CallKP(Symbol : String);
begin
  if (anActiveControl <> nil) and (anActiveControl.Acitve) then
    anActiveControl.aOnKeyPress(Symbol[1]);
//    anActiveControl.OnInput(Symbol);
end;

procedure zenTInputIntfs.CallKU(KeyCode : Byte);
var
  i: Integer;
  Key: Byte;
begin
  Key := KeyCode;
  for i := 0 to FCount - 1 do
    if zglTCtrl(FItems[i]).Enabled then
      zglTCtrl(FItems[i]).aOnKeyUp(Key);
end;


//*******************
// Settings and preSettings
//*******************

//Callback из ZenGL
procedure _MsgKeyDown(KeyCode : Byte);
begin
  zenII.CallKD(KeyCode);
end;

procedure _MsgChar(Symbol : String);
begin
  zenII.CallKP(Symbol);
end;

procedure _MsgKeyUp(KeyCode : Byte);
begin
  zenII.CallKU(KeyCode);
end;

procedure zglInitInput();
begin
  try
    zgl_Reg(INPUT_KEY_PRESS,   @_MsgKeyDown);
    zgl_Reg(INPUT_KEY_CHAR,    @_MsgChar   );
    zgl_Reg(INPUT_KEY_RELEASE, @_MsgKeyUp  );
  finally

  end;
end;


initialization
  zenII := zenTInputIntfs.Create();

finalization
  zenII.Free();

end.
